home *** CD-ROM | disk | FTP | other *** search
/ United Public Domain Gold 2 / United Public Domain Gold 2.iso / utilities / pu150.dms / pu150.adf / autoexec.AMOS / autoexec.amosSourceCode next >
AMOS Source Code  |  1978-02-21  |  26KB  |  499 lines
  1. Set Buffer 60
  2. 10 Rem************ football league program *****************  
  3. 12 Break Off : On Error Goto 15000
  4. 13 Screen Open 0,320,256,32,Lowres : Get Palette 0
  5. 14 Curs Off : Cls 0 : Wind Open 1,70,60,20,10,1 : Wind Save : Wind Close 
  6. 18 Flash Off 
  7. 20 Dim TEMP$(26),SCORE1(30),SCORE$(30),NAME$(26),TP(26),TW(26),TL(26),TD(26),TF(26),TA(26),TPTS(26),DIFF(30),FL(26),FL1(26)
  8. 21 Dim XPT(26),XP(26),XW(26),XD(26),XL(26),XF(26),XA(26),XN$(26),XDI(26),M(9),SCORE1$(26)
  9. 22 Limit Mouse 0,0 To 500,312
  10. 25 Curs Off : Screen Open 3,320,200,16,Lowres : Cls 0 : Screen Hide 3 : Curs On 
  11. 30 Load Iff "master:menu.iff",1 : Screen Hide 1
  12. 40 Load Iff "master:menu1.iff",2 : Screen Hide 2
  13. 42 Get Block 1,10,50,140,32 : Get Block 2,10,94,140,32 : Get Block 3,10,134,140,32
  14. 44 Get Block 4,167,50,140,32 : Get Block 5,167,94,140,32 : Get Block 6,167,134,140,32
  15. 46 Get Block 7,12,174,140,32 : Get Block 8,167,174,140,32 : Rem blocks to change menu colors 
  16. 53 Screen Close 0 : Auto View On 
  17. 55 Screen Open 0,320,256,32,Lowres : Curs Off : Get Palette 1 : Screen Copy 1 To 0
  18. 57 Proc TES
  19. 60 X=X Mouse : Y=Y Mouse : M=Mouse Click
  20. 70 If X>135 and X<=275 and Y>92 and Y<=122 and M=1 Then Put Block 1 : Goto 2000
  21. 80 If X>135 and X<=275 and Y>135 and Y<=166 and M=1 Then Put Block 2 : Goto 3000
  22. 90 If X>135 and X<=275 and Y>175 and Y<=209 and M=1 Then Put Block 3 : Goto 4000
  23. 100 If X>290 and X<=430 and Y>92 and Y<=122 and M=1 Then Put Block 4 : Goto 5000
  24. 110 If X>290 and X<=430 and Y>135 and Y<=166 and M=1 Then Put Block 5 : Goto 6000
  25. 120 If X>290 and X<=430 and Y>175 and Y<=209 and M=1 Then Put Block 6 : Goto 7000
  26. 130 If X>135 and X<=275 and Y>220 and Y<251 and M=1 Then Put Block 7 : Goto 8000
  27. 140 If X>290 and X<=430 and Y>220 and Y<=251 and M=1 Then Put Block 8 : Goto 9000
  28. 1000 Goto 60
  29. 2000 Rem************** update league ****************** 
  30. 2010 Wait 50 : Cls 0 : Pen 1 : Writing 0,2 : Locate 0,0 : Clear Key 
  31. 2020 Print "            UPDATE LEAGUE"
  32. 2025 If NAMEL$="" Then Locate 5,14 : Print "NO LEAGUE PRESENT IN DATABASE" : Goto 8100
  33. 2028 If DATE1$<>"" Then Locate 6,14 : Print "SCORES ARE ALREADY PRESENT" : Goto 8100
  34. 2030 Print : Print "           TYPE 'M' TO EXIT" : Print : Print "      ENTER MATCH SCORES" : Print : Line Input "      FOR DATE ";DATE1$
  35. 2034 DATE1$=Upper$(DATE1$) : If DATE1$="M" Then DATE1$="" : Goto 8110
  36. 2035 If Len(DATE1$)>12 or Len(DATE1$)<1 Then DATE1$="" : Goto 2000
  37. 2040 For K=1 To Len(DATE1$)
  38. 2042 TEMP$=Mid$(DATE1$,K,1)
  39. 2043 If TEMP$="/" Then TEMP$="-"
  40. 2044 If TEMP$="\" Then TEMP$="-"
  41. 2045 If TEMP$=":" Then TEMP$="-"
  42. 2046 If TEMP$="|" Then TEMP$="-"
  43. 2047 TEMP1$=TEMP1$+TEMP$
  44. 2048 Next K : DATE1$=TEMP1$ : TEMP1$=""
  45. 2050 Curs Off : Cls 0 : Locate 0,0 : Print "         INPUT MATCH RESULTS"
  46. 2060 Get Palette 3 : Pen 2 : Menu$(1)="TEAMS " : For K=1 To TEAMS : Menu$(1,K)=NAME$(K) : Next K : Menu$(1,TEAMS+1)="DONE"
  47. 2070 B7=2 : B8=4 : Menu On : CO=0 : CO1=0 : GAME=0 : For K=1 To TEAMS : FL(K)=1 : FL1(K)=0 : Next K
  48. 2080 If Choice Then GAME=Choice(2) Else GAME=0
  49. 2081 If GAME=TEAMS+1 and CO1=0 Then DATE1$="" : Menu Del(1) : Menu Off : Goto 8110
  50. 2085 If GAME=TEAMS+1 and CO=0 Then Menu Del(1) : Goto 2150 : Rem line out of loop 
  51. 2088 If GAME=TEAMS+1 Then GAME=0 : Goto 2080
  52. 2090 If GAME>0 Then Locate B7,B8 : Print NAME$(GAME) : Inc CO1 : SCORE$(CO1)=NAME$(GAME) : Menu Inactive(1,GAME) : FL(GAME)=0
  53. 2120 If GAME>0 Then Inc CO : If CO=2 Then CO=0 : B8=B8+2 : B7=2
  54. 2130 If GAME>0 and CO=1 Then B7=B7+19 : If CO=1 Then Locate 19,B8 : Print "v"
  55. 2140 Goto 2080
  56. 2150 Rem ****************** input scores ****************** 
  57. 2160 Pen 2 : Writing 0,2 : Locate 0,0
  58. 2170 Print "                                          " : Locate 0,0 : Print "          INPUT MATCH SCORES"
  59. 2180 Menu$(2)="SCORES " : For K=1 To 25 : Menu$(2,K)=Str$(K-1) : Next K : Menu$(2,26)="done"
  60. 2190 Menu On : D8=15 : D9=4 : NUMB=0 : CO2=0 : CO3=0
  61. 2200 If Choice Then NUMB=Choice(2) Else NUMB=0
  62. 2210 If NUMB=26 and CO3=CO1 Then Menu Del(2) : Menu Off : Goto 2270 : Rem line out of loop 
  63. 2220 If NUMB>0 and NUMB<=25 Then Locate D8,D9 : Print NUMB-1 : Inc CO3 : SCORE1(CO3)=NUMB-1
  64. 2230 If NUMB>0 and NUMB<=25 Then Inc CO2 : If CO2=2 Then CO2=0 : D9=D9+2 : D8=15
  65. 2240 If NUMB>0 and NUMB<=25 and CO2=1 Then D8=D8+19
  66. 2250 If CO3=CO1 Then For K=1 To 25 : Menu Inactive(2,K) : Next K : Rem counter for matches & scores 
  67. 2260 Goto 2200
  68. 2270 Rem ****************** print results & verify ********************** 
  69. 2280 Cls 0 : Get Palette 1 : Pen 1 : Writing 0,2 : Locate 0,0
  70. 2290 Print "         ARE THESE RESULTS OK?"
  71. 2300 Print : A8=3
  72. 2310 For K=1 To CO1 Step 2
  73. 2320 Locate 2,A8 : Print SCORE$(K) : Locate 15,A8 : Print SCORE1(K) : Locate 20,A8 : Print SCORE$(K+1) : Locate 32,A8 : Print SCORE1(K+1)
  74. 2330 Inc A8 : Inc A8
  75. 2340 Next K
  76. 2350 Locate 3,30 : Print Border$("  NO  ",1); : Locate 27,30 : Print Border$("  YES  ",1)
  77. 2355 Writing 0,1 : Pen 3
  78. 2360 M=Mouse Click : X=X Mouse : Y=Y Mouse
  79. 2370 If X>148 and X<=201 and Y>278 and Y<=292 and M=1 Then DATE1$="" : Locate 3,30 : Print Border$("  NO  ",1) : Wait 75 : Goto 2000
  80. 2380 If X>341 and X<=402 and Y>278 and Y<=292 and M=1 Then Locate 27,30 : Print Border$("  YES  ",1) : Wait 75 : Goto 2400
  81. 2390 Goto 2360
  82. 2400 Cls 0 : Writing 0,2 : Pen 1
  83. 2410 Locate 7,14 : Print "UPDATE LEAGUE POSITIONS?"
  84. 2450 Locate 3,30 : Print Border$("  NO  ",1); : Locate 27,30 : Print Border$("  YES  ",1)
  85. 2455 Writing 0,1 : Pen 3
  86. 2460 M=Mouse Click : X=X Mouse : Y=Y Mouse
  87. 2470 If X>148 and X<=201 and Y>278 and Y<=292 and M=1 Then Locate 3,30 : Print Border$("  NO  ",1) : Wait 75 : Goto 8110
  88. 2480 If X>341 and X<=402 and Y>278 and Y<=292 and M=1 Then Locate 27,30 : Print Border$("  YES  ",1) : Wait 75 : Goto 2500
  89. 2490 Goto 2460
  90. 2500 Cls 0 : Writing 0,2 : Pen 1
  91. 2510 Locate 5,10 : Print " UPDATING LEAGUE POSITIONS"
  92. 2520 Gosub 10000
  93. 2530 Goto 8110
  94. 3000 Rem *************** edit league *********************
  95. 3010 Curs Off : Wait 50 : Cls 0 : Pen 1 : Writing 0,2 : Locate 0,0
  96. 3020 Print "             EDIT LEAGUE"
  97. 3030 If NAMEL$="" Then Locate 4,14 : Print "NO LEAGUE PRESENT IN DATABASE" : Wait 50 : Goto 8100
  98. 3040 Get Palette 3 : Pen 2 : Clear Key 
  99. 3045 Menu$(5)="TEAMS" : For K=1 To TEAMS : Menu$(5,K)=NAME$(K) : Next K : Menu$(5,TEAMS+1)="CHANGE NAME"
  100. 3050 Menu$(5,TEAMS+2)="CLEAR LEAGUE" : Menu$(5,TEAMS+3)="DONE" : Menu On 
  101. 3060 If Choice Then SELECT=Choice(2) Else SELECT=0
  102. 3065 If SELECT=TEAMS+1 Then Menu Del(5) : Menu Off : Goto 3500
  103. 3070 If SELECT=TEAMS+3 Then Menu Del(5) : Menu Off : Goto 8110
  104. 3080 If SELECT=TEAMS+2 Then Menu Del(5) : Menu Off : Goto 3900
  105. 3090 If SELECT>0 and SELECT<=TEAMS Then Menu Del(5) : Menu Off : Goto 3200
  106. 3100 Goto 3060
  107. 3200 Rem *************** edit teams data ********************** 
  108. 3205 MM$=NAME$(SELECT) : M(1)=TP(SELECT) : M(2)=TW(SELECT)
  109. 3206 M(3)=TD(SELECT) : M(4)=TL(SELECT) : M(5)=TF(SELECT) : M(6)=TA(SELECT)
  110. 3207 M(7)=TPTS(SELECT) : TP$="" : TW$="" : TD$="" : TL$="" : TF$="" : TA$="" : TPTS$=""
  111. 3210 Locate 1,10 : Print "TEAM            P  W  D  L  F   A   PTS"
  112. 3220 Locate 1,12 : Print MM$
  113. 3230 Locate 16,12 : Print M(1) : Locate 19,12 : Print M(2)
  114. 3240 Locate 22,12 : Print M(3) : Locate 25,12 : Print M(4)
  115. 3250 Locate 28,12 : Print M(5) : Locate 32,12 : Print M(6)
  116. 3260 Locate 36,12 : Print M(7)
  117. 3270 Locate 1,16 : Print "TEAM            P  W  D  L  F   A   PTS"
  118. 3280 Locate 0,18 : Line Input " ";NAME$(SELECT) : NAME$(SELECT)=Upper$(NAME$(SELECT)) : If Len(NAME$(SELECT))<1 or Len(NAME$(SELECT))>13 Then NAME$(SELECT)=MM$ : Locate 1,18 : Print MM$
  119. 3290 Locate 16,18 : Input " ";TP$ : If TP$="" Then TP(SELECT)=M(1) : Locate 16,18 : Print M(1) : Else TP(SELECT)=Val(TP$)
  120. 3295 Locate 19,18 : Input " ";TW$ : If TW$="" Then TW(SELECT)=M(2) : Locate 19,18 : Print M(2) : Else TW(SELECT)=Val(TW$)
  121. 3300 Locate 22,18 : Input " ";TD$ : If TD$="" Then TD(SELECT)=M(3) : Locate 22,18 : Print M(3) : Else TD(SELECT)=Val(TD$)
  122. 3305 Locate 25,18 : Input " ";TL$ : If TL$="" Then TL(SELECT)=M(4) : Locate 25,18 : Print M(4) : Else TL(SELECT)=Val(TL$)
  123. 3310 Locate 28,18 : Input " ";TF$ : If TF$="" Then TF(SELECT)=M(5) : Locate 28,18 : Print M(5) : Else TF(SELECT)=Val(TF$)
  124. 3315 Locate 32,18 : Input " ";TA$ : If TA$="" Then TA(SELECT)=M(6) : Locate 32,18 : Print M(6) : Else TA(SELECT)=Val(TA$)
  125. 3320 Locate 36,18 : Input " ";TPTS$ : If TPTS$="" Then TPTS(SELECT)=M(7) : Locate 36,18 : Print M(7) : Else TPTS(SELECT)=Val(TPTS$)
  126. 3330 Curs Off : Locate 9,28 : Print "NEW LEAGUE DATA ENTERED" : Wait 100 : For K=1 To 9 : M(K)=0 : Next K : MM$=""
  127. 3350 Cls 0 : Get Palette 1 : Writing 0,2 : Pen 1
  128. 3360 Locate 7,14 : Print "UPDATE LEAGUE POSITIONS?"
  129. 3370 Locate 3,30 : Print Border$("  NO  ",1); : Locate 27,30 : Print Border$("  YES  ",1)
  130. 3375 Writing 0,1 : Pen 1
  131. 3380 M=Mouse Click : X=X Mouse : Y=Y Mouse
  132. 3390 If X>148 and X<=201 and Y>278 and Y<=292 and M=1 Then Locate 3,30 : Print Border$("  NO  ",1) : Wait 75 : Goto 3000
  133. 3400 If X>341 and X<=402 and Y>278 and Y<=292 and M=1 Then Locate 27,30 : Print Border$("  YES  ",1) : Wait 75 : Goto 3420
  134. 3410 Goto 3380
  135. 3420 Cls 0 : Writing 0,2 : Pen 1
  136. 3430 Locate 5,10 : Print " UPDATING LEAGUE POSITIONS"
  137. 3440 Gosub 10160 : Goto 3000
  138. 3500 Rem******************* input new league name **************
  139. 3505 M$=NAMEL$
  140. 3510 Locate 4,14 : Print "CURRENT LEAGUE NAME-:";NAMEL$
  141. 3515 Locate 4,18 : Line Input "NEW LEAGUE NAME-:";NAMEL$ : NAMEL$=Upper$(NAMEL$)
  142. 3520 If Len(NAMEL$)<1 or Len(NAMEL$)>12 Then NAMEL$=M$
  143. 3522 For K=1 To Len(NAMEL$)
  144. 3523 TEMP$=Mid$(NAMEL$,K,1)
  145. 3524 If TEMP$="/" Then TEMP$="-"
  146. 3525 If TEMP$="\" Then TEMP$="-"
  147. 3526 If TEMP$=":" Then TEMP$="-"
  148. 3527 If TEMP$="|" Then TEMP$="-"
  149. 3528 TEMP1$=TEMP1$+TEMP$
  150. 3529 Next K : NAMEL$=TEMP1$ : TEMP1$=""
  151. 3530 M$=""
  152. 35400 Goto 3000
  153. 3900 Rem *************** clear league database ***********
  154. 3910 For K=1 To TEAMS
  155. 3915 NAME$(K)="" : TP(K)=0
  156. 3920 TP(K)=0 : TW(K)=0
  157. 3930 TL(K)=0 : TD(K)=0
  158. 3940 TF(K)=0 : TA(K)=0
  159. 3950 TPTS(K)=0 : DIFF(K)=0
  160. 3960 Next K
  161. 3965 NAMEL$="" : DATE$="" : TEAMS=0
  162. 3970 Locate 7,28 : Print "LEAGUE DATABASE NOW CLEAR" : Wait 50 : Goto 8100
  163. 4000 Rem *************** view league *********************
  164. 4010 Wait 50 : Cls 0 : Pen 1 : Writing 0,2 : Locate 0,0
  165. 4020 Print "       VIEW LEAGUE-";NAMEL$;
  166. 4030 If NAMEL$="" Then Print "NOT AVAILABLE" : Locate 4,14 : Print " NO LEAGUE PRESENT IN DATABASE" : Goto 8100
  167. 4035 Locate 0,2 : Print "TEAM          P  W  D  L  F   A   PTS" : Print 
  168. 4036 B1=13 : B2=4
  169. 4040 For K=1 To TEAMS
  170. 4041 Print NAME$(K)
  171. 4042 Locate B1,B2 : Print TP(K)
  172. 4045 Locate B1+3,B2 : Print TW(K)
  173. 4048 Locate B1+6,B2 : Print TD(K)
  174. 4049 Locate B1+9,B2 : Print TL(K)
  175. 4052 Locate B1+12,B2 : Print TF(K)
  176. 4055 Locate B1+16,B2 : Print TA(K)
  177. 4058 Locate B1+20,B2 : Print TPTS(K)
  178. 4070 B2=B2+1 : Next K
  179. 4105 Print : Print "          PRESS MOUSE BUTTON";
  180. 4110 M=Mouse Click : If M=0 Then 4110
  181. 4120 Goto 8110 : Rem back to menu 
  182. 5000 Rem *************** edit scores *************************
  183. 5010 Wait 50 : Get Palette 3 : Cls 0 : Pen 2 : Writing 0,2 : Locate 0,0 : Curs Off 
  184. 5015 Print "             EDIT SCORES"
  185. 5020 If DATE1$="" Then Locate 8,14 : Print "NO SCORES PRESENT YET" : Goto 8100
  186. 5030 Menu$(4)="TEAMS" : For K=1 To CO1 : Menu$(4,K)=SCORE$(K) : Next K : Menu$(4,CO1+2)="DONE" : Menu$(4,CO1+1)="CLEAR ALL"
  187. 5040 Menu On 
  188. 5050 If Choice Then GAME=Choice(2) Else GAME=0
  189. 5060 If GAME=CO1+2 Then Menu Del(4) : Menu Off : Goto 8110
  190. 5070 If GAME=CO1+1 Then Menu Del(4) : Menu Off : Goto 5500
  191. 5080 If GAME>0 Then Menu Del(4) : Menu Off : Goto 5110
  192. 5100 Goto 5050
  193. 5110 Rem ************** input new data ********************** 
  194. 5115 TEMP$=SCORE$(GAME) : TEMP=SCORE1(GAME)
  195. 5120 Locate 4,12 : Print SCORE$(GAME)+" "; : Print TEMP
  196. 5130 Locate 4,20 : Line Input "TEAM NAME ";SCORE$(GAME) : SCORE$(GAME)=Upper$(SCORE$(GAME))
  197. 5131 If Len(SCORE$(GAME))>13 Then Locate 4,30 : Print "      NAME TOO LONG        " : SCORE$(GAME)=TEMP$ : SCORE1(GAME)=TEMP : Goto 5140
  198. 5132 If Len(SCORE$(GAME))<1 Then SCORE$(GAME)=TEMP$ : Locate 14,20 : Print TEMP$
  199. 5133 Locate 28,20
  200. 5134 Input "SCORE ";SCORE1$(GAME) : If Len(SCORE1$(GAME))=0 or Val(SCORE1$(GAME))>24 Then SCORE1$(GAME)=Str$(TEMP) : Locate 33,20 : Print TEMP;" "
  201. 5135 SCORE1(GAME)=Val(SCORE1$(GAME))
  202. 5140 Curs Off : Wait 100
  203. 5150 Goto 5000
  204. 5500 Rem ************** clear all score variables ***************** 
  205. 5510 For K=1 To 26 : SCORE$(K)="" : SCORE1(K)=0 : Next K : CO1=0 : CO3=0 : DATE1$=""
  206. 5520 Locate 6,30 : Print "   SCORE DATABASE CLEARED" : Wait 50 : Goto 8100
  207. 6000 Rem ****************** view scores *********************** 
  208. 6010 Wait 50 : Get Palette 1 : Cls 0 : Pen 1 : Writing 0,2 : Locate 0,0
  209. 6020 Print "      VIEW SCORES-DATE ";DATE1$
  210. 6025 If DATE1$="" Then Locate 17,0 : Print "-NOT AVAILABLE" : Locate 8,14 : Print "NO SCORES PRESENT YET " : Wait 50 : Goto 8100
  211. 6030 Print : A9=3
  212. 6040 For K=1 To CO1 Step 2
  213. 6050 Locate 1,A9 : Print SCORE$(K) : Locate 14,A9 : Print SCORE1(K) : Locate 20,A9 : Print SCORE$(K+1) : Locate 33,A9 : Print SCORE1(K+1)
  214. 6060 Inc A9 : Inc A9
  215. 6070 Next K
  216. 6080 Locate 3,30 : Print " PRESS MOUSE TO RETURN TO MENU"
  217. 6090 M=Mouse Click : If M<>0 Then 8110
  218. 6100 Goto 6090
  219. 7000 Rem ******************* disk access ***********************
  220. 7010 Wait 50 : Cls 0 : Get Palette 3 : Pen 2 : Writing 0,2 : Locate 14,0
  221. 7020 Print "DISK ACCESS"
  222. 7030 Print : Under On : Locate 3,3 : Print "LOADING A LEAGUE WILL ERASE DATA" : Under Off 
  223. 7040 Menu$(3)="FILES" : Menu$(3,1)="LOAD LEAGUE" : Menu$(3,2)="SAVE LEAGUE" : Menu$(3,3)="LOAD SCORES"
  224. 7050 Menu$(3,4)="SAVE SCORES" : Menu$(3,5)="PRINT SCORES" : Menu$(3,6)="PRINT LEAGUE" : Menu$(3,7)="KILL LEAGUE FILE" : Menu$(3,8)="KILL SCORE FILE" : Menu$(3,9)="MAIN MENU"
  225. 7060 Menu On 
  226. 7089 If Choice Then DSK=Choice(2) Else DSK=0
  227. 7090 If DSK=1 Then DSK=0 : Menu Del(3) : Menu Off : Goto 7200
  228. 7100 If DSK=2 Then DSK=0 : Menu Del(3) : Menu Off : Goto 7300
  229. 7102 If DSK=3 Then DSK=0 : Menu Del(3) : Menu Off : Goto 7400
  230. 7105 If DSK=4 Then DSK=0 : Menu Del(3) : Menu Off : Goto 7500
  231. 7106 If DSK=5 Then DSK=0 : Menu Del(3) : Menu Off : Goto 7700
  232. 7107 If DSK=6 Then DSK=0 : Menu Del(3) : Menu Off : Goto 7800
  233. 7108 If DSK=7 Then DSK=0 : Menu Del(3) : Menu Off : Goto 7930
  234. 7109 If DSK=8 Then DSK=0 : Menu Del(3) : Menu Off : Goto 7900
  235. 7110 If DSK=9 Then DSK=0 : Menu Del(3) : Menu Off : Goto 8110
  236. 7140 Goto 7089
  237. 7200 Rem ***************** load division ********************** 
  238. 7201 If Exist("football:leagues/") Then Dir$="football:leagues/" Else Proc DAT
  239. 7203 TEAMS=0 : NAMEL$="" : DATE$="" : DATE1$="" : CO1=0 : CO3=0 : Rem clear variables
  240. 7205 For K=1 To 26 : NAME$(K)="" : TP(K)=0 : TW(K)=0 : TL(K)=0 : TD(K)=0 : TF(K)=0 : TA(K)=0 : DIFF(K)=0 : SCORE$(K)="" : SCORE1(K)=0 : Next K
  241. 7210 F$=Fsel$("football:leagues/","","LOAD LEAGUE NAMES ")
  242. 7220 If F$="" Then 8110
  243. 7225 For K=18 To Len(F$) : F1$=F1$+Mid$(F$,K,1) : Next K : F$=F1$ : F1$=""
  244. 7230 NAMEL$=F$ : F$=""
  245. 7240 Open In 1,NAMEL$
  246. 7245 Line Input #1,DATE$
  247. 7250 Input #1,TEAMS
  248. 7255 For K=1 To TEAMS
  249. 7260 Line Input #1,NAME$(K)
  250. 7265 Input #1,TP(K) : Input #1,TW(K) : Input #1,TL(K) : Input #1,TD(K) : Input #1,TF(K) : Input #1,TA(K) : Input #1,TPTS(K) : Input #1,DIFF(K)
  251. 7270 Next K
  252. 7280 Close 1 : Get Palette 1 : Cls 0 : Pen 1 : Writing 0,2
  253. 7285 Locate 14,0 : Print "DISK ACCESS" : Locate 12,14 : Print "DATA LOADED OK!" : Wait 50 : Goto 8100
  254. 7300 Rem ******************** save division *********************** 
  255. 7302 If NAMEL$="" Then Cls 0 : Locate 2,10 : Print "   NO LEAGUE AVAILABLE FOR SAVING" : Goto 8100
  256. 7305 If Exist("football:leagues/") Then Dir$="football:leagues/" Else Proc DAT
  257. 7310 Open Out 1,NAMEL$
  258. 7312 Print #1,DATE$
  259. 7314 Print #1,TEAMS
  260. 7320 For K=1 To TEAMS
  261. 7330 Print #1,NAME$(K)
  262. 7340 Print #1,TP(K) : Print #1,TW(K) : Print #1,TL(K) : Print #1,TD(K) : Print #1,TF(K) : Print #1,TA(K) : Print #1,TPTS(K) : Print #1,DIFF(K)
  263. 7350 Next K
  264. 7360 Close 1
  265. 7370 Cls 0 : Get Palette 1 : Pen 1 : Writing 0,2
  266. 7380 Locate 14,0 : Print "DISK ACCESS" : Locate 12,14 : Print "DATA SAVED  OK!" : Wait 50 : Goto 8100
  267. 7400 Rem ********************* load scores ***********************
  268. 7410 If DATE1$<>"" Then Locate 6,14 : Print "  SCORES ALREADY PRESENT " : Wait 50 : Goto 8100
  269. 7415 If Exist("football:scores/") Then Dir$="football:scores/" Else Proc DAT1
  270. 7420 F6$=Fsel$("football:scores/","","LOAD SCORE SET")
  271. 7430 If F6$="" Then 8110
  272. 7440 For K=17 To Len(F6$) : F7$=F7$+Mid$(F6$,K,1) : Next K : F6$=F7$ : F7$=""
  273. 7450 DATE1$=F6$ : F6$=""
  274. 7460 Open In 1,DATE1$
  275. 7465 Input #1,CO1
  276. 7470 For K=1 To CO1
  277. 7475 Line Input #1,SCORE$(K)
  278. 7480 Input #1,SCORE1(K)
  279. 7485 Next K
  280. 7490 Goto 7280
  281. 7500 Rem ********************* save scores ***********************
  282. 7510 If DATE1$="" Then Locate 2,14 : Print "  NO SCORES AVAILABLE FOR SAVING" : Wait 50 : Goto 8100
  283. 7515 If Exist("football:scores/") Then Dir$="football:scores/" Else Proc DAT1
  284. 7560 Open Out 1,DATE1$
  285. 7570 Print #1,CO1
  286. 7580 For K=1 To CO1
  287. 7590 Print #1,SCORE$(K)
  288. 7600 Print #1,SCORE1(K)
  289. 7610 Next K
  290. 7620 Goto 7360
  291. 7700 Rem ************* print  scores ***********************  
  292. 7710 If DATE1$="" Then Locate 2,14 : Print " NO SCORES AVAILABLE FOR PRINTING" : Wait 50 : Goto 8100
  293. 7711 Proc STAR : If PRI=1 Then 7720 Else Goto 8110
  294. 7720 Open Port 2,"par:"
  295. 7730 Print #2,"DATE-:"+DATE1$ : Print #2,
  296. 7740 For K=1 To CO1 Step 2
  297. 7745 AA$="             " : BB$=Left$(AA$,13-Len(SCORE$(K))) : CC$=Left$(AA$,13-Len(SCORE$(K+1)))
  298. 7750 Print #2,SCORE$(K);BB$;" "; : If SCORE1(K)<=9 Then Print #2,SCORE1(K);"   "; Else If SCORE1(K)>9 Then Print #2,SCORE1(K);"  ";
  299. 7755 Print #2,SCORE$(K+1);CC$;" "; : Print #2,SCORE1(K+1)
  300. 7760 Next K
  301. 7770 Close 2 : Goto 8110
  302. 7800 Rem***************** print league *********************
  303. 7810 If NAMEL$="" Then Locate 2,14 : Print "NO LEAGUE AVAILABLE FOR PRINTING" : Wait 50 : Goto 8100
  304. 7811 Proc STAR : If PRI=1 Then 7820 Else Goto 8110
  305. 7820 Open Port 2,"par:"
  306. 7830 Print #2,"LEAGUE -:";NAMEL$; : Print #2,"  DATE CREATED-:";DATE$; : Print #2,"  NO OF TEAMS-:";TEAMS : Print #2,
  307. 7840 Print #2,"TEAM           P  W  D  L  F    A    PTS     G/DIFF"
  308. 7850 For K=1 To TEAMS
  309. 7860 AA$="            " : BB$=Left$(AA$,13-Len(NAME$(K)))
  310. 7870 Print #2,NAME$(K)+BB$; : Print #2," ";
  311. 7871 If TP(K)>9 Then Print #2,TP(K); Else Print #2,TP(K);" ";
  312. 7872 If TW(K)>9 Then Print #2,TW(K); Else Print #2,TW(K);" ";
  313. 7873 If TD(K)>9 Then Print #2,TD(K); Else Print #2,TD(K);" ";
  314. 7874 If TL(K)>9 Then Print #2,TL(K); Else Print #2,TL(K);" ";
  315. 7875 If TF(K)<=9 Then Print #2,TF(K);"   "; Else If TF(K)>9 and TF(K)<99 Then Print #2,TF(K);"  "; Else If TF(K)>99 Then Print #2,TF(K);" ";
  316. 7876 If TA(K)<=9 Then Print #2,TA(K);"   "; Else If TA(K)>9 and TA(K)<99 Then Print #2,TA(K);"  "; Else If TA(K)>99 Then Print #2,TA(K);" ";
  317. 7877 If TPTS(K)<=9 Then Print #2,TPTS(K);"   "; Else If TPTS(K)>9 and TPTS(K)<99 Then Print #2,TPTS(K);"  "; Else If TPTS(K)>99 Then Print #2,TPTS(K);" ";
  318. 7878 If DIFF(K)>=0 Then Print #2,"    +";Abs(DIFF(K))
  319. 7879 If DIFF(K)<0 Then Print #2,"    -";Abs(DIFF(K))
  320. 7880 Next K
  321. 7885 Print #2,"-------------------------------------------------"
  322. 7886 For K=1 To 20 : Print #2, : Next K
  323. 7890 Goto 7770
  324. 7900 Rem ************* kill score files ************************
  325. 7901 Cls 0 : Writing 0,2 : Pen 1 : Get Palette 1 : Locate 0,0
  326. 7902 Print "           MURDER SCORE FILE"
  327. 7905 If Exist("football:scores/") Then Dir$="football:scores/" Else Proc DAT1
  328. 7910 F6$=Fsel$("football:scores/","","KILL SCORE FILE")
  329. 7915 If F6$="" Then 8110
  330. 7920 Kill F6$
  331. 7925 Cls 0 : Pen 1 : Writing 0,2 : Get Palette 1 : Locate 8,14 : Print "SCORE FILE ANNIHILATED" : Boom : F6$="" : Wait 50 : Goto 8100
  332. 7930 Rem *************** kill league files *****************
  333. 7931 Cls 0 : Writing 0,2 : Pen 1 : Get Palette 1 : Locate 0,0
  334. 7932 Print "           MURDER LEAGUE FILE"
  335. 7933 If Exist("football:leagues/") Then Dir$="football:leagues/" Else Proc DAT1
  336. 7934 F6$=Fsel$("football:leagues/","","KILL LEAGUE FILE")
  337. 7935 If F6$="" Then 8110
  338. 7936 Kill F6$
  339. 7937 Cls 0 : Pen 1 : Writing 0,2 : Get Palette 1 : Locate 7,14 : Print "LEAGUE FILE ANNIHILATED" : Boom : F6$="" : Wait 50 : Goto 8100
  340. 8000 Rem ************* create league ***********************  
  341. 8001 Wait 50 : Cls 0 : Pen 1 : Writing 0,2 : Locate 0,0 : Clear Key 
  342. 8005 Print "            CREATE LEAGUE"
  343. 8007 Print : Print "   TYPE 'M' TO RETURN TO MAIN MENU"
  344. 8008 If NAMEL$<>"" Then Locate 5,12 : Print "   LEAGUE ALREADY PRESENT" : Goto 8100
  345. 8010 If DATE1$<>"" Then For K=1 To 26 : SCORE$(K)="" : SCORE1(K)=0 : TP(K)=0 : TW(K)=0 : TL(K)=0 : TD(K)=0 : TF(K)=0 : TA(K)=0 : DIFF(K)=0 : Next K : CO1=0 : CO3=0 : DATE1$=""
  346. 8015 Locate 3,10 : Line Input "LEAGUE NAME ";NAMEL$
  347. 8019 NAMEL$=Upper$(NAMEL$) : If NAMEL$="M" Then NAMEL$="" : Goto 8110
  348. 8021 If Len(NAMEL$)<1 or Len(NAMEL$)>12 Then NAMEL$="" : Curs Off : Goto 8000
  349. 8022 For K=1 To Len(NAMEL$)
  350. 8023 TEMP$=Mid$(NAMEL$,K,1)
  351. 8024 If TEMP$="/" Then TEMP$="-"
  352. 8025 If TEMP$="\" Then TEMP$="-"
  353. 8026 If TEMP$=":" Then TEMP$="-"
  354. 8027 If TEMP$="|" Then TEMP$="-"
  355. 8028 TEMP1$=TEMP1$+TEMP$
  356. 8029 Next K : NAMEL$=TEMP1$ : TEMP1$=""
  357. 8030 Locate 3,12 : Line Input "DATE ";DATE$ : DATE$=Upper$(DATE$)
  358. 8031 If Len(DATE$)>13 or Len(DATE$)<1 Then DATE$="" : NAMEL$="" : Curs Off : Goto 8000
  359. 8032 For K=1 To Len(DATE$)
  360. 8033 TEMP$=Mid$(DATE$,K,1)
  361. 8034 If TEMP$="/" Then TEMP$="-"
  362. 8035 If TEMP$="\" Then TEMP$="-"
  363. 8036 If TEMP$=":" Then TEMP$="-"
  364. 8037 If TEMP$="|" Then TEMP$="-"
  365. 8038 TEMP1$=TEMP1$+TEMP$
  366. 8039 Next K : DATE$=TEMP1$ : TEMP1$=""
  367. 8040 Locate 3,14 : Print "NUMBER OF TEAMS IN LEAGUE" : Locate 3,15 : Input "(1-26) ";TEAMS$ : TEAMS=Val(TEAMS$) : TEAMS$=""
  368. 8041 If TEAMS<>Int(TEAMS/2)*2 Then TEAMS=50
  369. 8042 If TEAMS>26 or TEAMS<=1 Then TEAMS=0 : DATE$="" : NAMEL$="" : Curs Off : Goto 8000
  370. 8047 Curs Off : Wait 50 : Locate 0,0 : Cls 0 : Clear Key 
  371. 8048 Print "        PLEASE ENTER TEAM NAMES" : Print : Print 
  372. 8050 For K=1 To TEAMS
  373. 8060 Print "TEAM NO";K; : Line Input " ";NAME$(K)
  374. 8065 If NAME$(K)="" Then Cup : Goto 8060
  375. 8066 If Len(NAME$(K))>13 Then Cup : NAME$(K)="" : Print "                                     " : Cup : Goto 8060
  376. 8070 Next K
  377. 8080 For K=1 To TEAMS : NAME$(K)=Upper$(NAME$(K)) : Next K : Goto 8110
  378. 8100 Curs Off : Wait 100
  379. 8110 Curs Off : Proc TES : Dir$="df0:" : Get Palette 1 : Screen Copy 1 To 0 : Writing 0,2 : Pen 1 : Goto 60 : Rem back to menu 
  380. 9000 Rem ***************** exit program ******************* 
  381. 9010 Cls 0 : Get Palette 1 : Pen 1 : Writing 0,2 : Locate 0,14
  382. 9020 Print " ARE YOU SURE,YOU REALLY WANT TO FINISH"
  383. 9025 Print 
  384. 9030 Print "RIGHT MOUSE TO END--LEFT MOUSE CONTINUES"
  385. 9040 Do 
  386. 9050 M=Mouse Click
  387. 9060 If M<>0 Then Exit 
  388. 9070 Loop 
  389. 9090 If M=2 Then End 
  390. 9100 Goto 8110
  391. 10000 Rem ************* sort routine for league placings ****************
  392. 10070 Rem routine for matches won/lost/points/goals for & against/matches played 
  393. 10080 For K=1 To CO1 Step 2
  394. 10090 For T=1 To TEAMS
  395. 10100 If SCORE$(K)=NAME$(T) and SCORE1(K)>SCORE1(K+1) Then Inc TW(T) : TPTS(T)=TPTS(T)+3
  396. 10105 If SCORE$(K)=NAME$(T) and SCORE1(K)=SCORE1(K+1) Then Inc TD(T) : TPTS(T)=TPTS(T)+1
  397. 10110 If SCORE$(K)=NAME$(T) and SCORE1(K)<SCORE1(K+1) Then Inc TL(T) : TPTS(T)=TPTS(T)
  398. 10112 If SCORE$(K)=NAME$(T) Then Inc TP(T) : TF(T)=TF(T)+SCORE1(K) : TA(T)=TA(T)+SCORE1(K+1)
  399. 10115 If SCORE$(K+1)=NAME$(T) and SCORE1(K+1)>SCORE1(K) Then Inc TW(T) : TPTS(T)=TPTS(T)+3
  400. 10120 If SCORE$(K+1)=NAME$(T) and SCORE1(K+1)=SCORE1(K) Then Inc TD(T) : TPTS(T)=TPTS(T)+1
  401. 10125 If SCORE$(K+1)=NAME$(T) and SCORE1(K+1)<SCORE1(K) Then Inc TL(T) : TPTS(T)=TPTS(T)
  402. 10128 If SCORE$(K+1)=NAME$(T) Then Inc TP(T) : TF(T)=TF(T)+SCORE1(K+1) : TA(T)=TA(T)+SCORE1(K)
  403. 10130 Next T
  404. 10140 Next K
  405. 10160 Rem ************* sort routine for correct order ******************* 
  406. 10170 For K=1 To TEAMS : DIFF(K)=(TF(K)-TA(K)) : Next K
  407. 10180 K=1 : W=1 : X5=0 : T=-400 : CC=-400
  408. 10190 Do 
  409. 10200 If T<TPTS(K) Then T=TPTS(K) : X5=K
  410. 10205 If T=TPTS(K) and CC<DIFF(K) Then CC=DIFF(K) : X5=K
  411. 10210 Inc K
  412. 10220 If K=TEAMS+1 Then Proc SWOP : Inc W : TPTS(X5)=-500 : T=-400 : K=1 : DIFF(X5)=-500 : CC=-400
  413. 10230 If W=TEAMS+1 Then Exit 
  414. 10240 Loop 
  415. 10245 Rem **************** transfer teams from dummy variables ************
  416. 10250 For K=1 To TEAMS
  417. 10260 TPTS(K)=XPT(K) : XPT(K)=0
  418. 10270 TP(K)=XP(K) : XP(K)=0
  419. 10280 TW(K)=XW(K) : XW(K)=0
  420. 10290 TD(K)=XD(K) : XD(K)=0
  421. 10300 TL(K)=XL(K) : XL(K)=0
  422. 10310 TF(K)=XF(K) : XF(K)=0
  423. 10320 TA(K)=XA(K) : XA(K)=0
  424. 10330 NAME$(K)=XN$(K) : XN$(K)=""
  425. 10340 DIFF(K)=XDI(K) : XDI(K)=0
  426. 10345 Next K
  427. 10350 Return 
  428. 15000 Curs Off : Get Palette 1 : Pen 1 : Cls 0 : Writing 0,2 : Locate 3,14
  429. 15010 Print "PROGRAM NOW IN ERROR TRAP,PLEASE "
  430. 15020 Locate 3,16 : Print "INFORM AUTHOR OF ERROR CONDITION "
  431. 15025 Locate 5,26 : Print "PRESS MOUSE TO ATTEMPT RESUME"
  432. 15030 Do 
  433. 15040 M=Mouse Click
  434. 15050 If M<>0 Then Exit 
  435. 15060 Loop 
  436. 15070 Resume 8110
  437. Procedure SWOP
  438. Shared XPT(),XP(),XW(),XD(),XL(),XF(),XA(),XN$(),XDI(),W,X5
  439. Shared TPTS(),TP(),TW(),TD(),TL(),TF(),TA(),NAME$(),DIFF()
  440. XPT(W)=TPTS(X5) : Rem swap points
  441. XP(W)=TP(X5) : Rem swap played
  442. XW(W)=TW(X5) : Rem swap wins
  443. XD(W)=TD(X5) : Rem swap draws 
  444. XL(W)=TL(X5) : Rem swap losses
  445. XF(W)=TF(X5) : Rem swap goals for 
  446. XA(W)=TA(X5) : Rem swap goals against 
  447. XN$(W)=NAME$(X5) : Rem swap names 
  448. XDI(W)=DIFF(X5) : Rem Swap goal difference 
  449. End Proc
  450. Procedure DAT
  451. Cls 0 : Get Palette 1 : Pen 1 : Writing 0,2
  452. Locate 1,14 : Print "PLEASE INSERT DATA DISK & PRESS MOUSE"
  453. Do 
  454. M=Mouse Click
  455. If M<>0 Then Exit 
  456. Loop 
  457. If Exist("football:leagues/") Then Dir$="football:leagues/" Else Proc DAT
  458. Cls 0 : Locate 0,0 : Print "              DISK ACCESS"
  459. End Proc
  460. Procedure DAT1
  461. Cls 0 : Get Palette 1 : Pen 1 : Writing 0,2
  462. Locate 1,14 : Print "PLEASE INSERT DATA DISK & PRESS MOUSE"
  463. Do 
  464. M=Mouse Click
  465. If M<>0 Then Exit 
  466. Loop 
  467. If Exist("football:scores/") Then Dir$="football:scores/" Else Proc DAT1
  468. Cls 0 : Locate 0,0 : Print "              DISK ACCESS"
  469. End Proc
  470. Procedure STAR
  471. Shared PRI
  472. Cls 0
  473. Wind Save 
  474. Wind Open 2,70,60,18,10,1 : Curs Off 
  475. Title Top "----PRINTER----"
  476. Pen 0 : Print " ----CRASH-----"
  477. Print "     ALERT"
  478. Print : Pen 0 : Print " PRINTER READY?"
  479. Ink 0 : Bar 80,110 To 116,131
  480. Bar 170,110 To 207,131
  481. Gr Writing 0 : Ink 7 : Text 86,125,"YES" : Text 183,125,"NO"
  482. Do 
  483. X=X Mouse : Y=Y Mouse : M=Mouse Click
  484. If X>208 and X<=243 and Y>160 and Y<=180 and M=1 Then PRI=1 : Exit 
  485. If X>299 and X<=335 and Y>160 and Y<=180 and M=1 Then PRI=2 : Exit 
  486. Loop 
  487. Wind Close 
  488. End Proc
  489. Procedure TES
  490. L1=%11111111
  491. L2=%10000001
  492. L3=%10000001
  493. L4=%10000001
  494. L5=%10000001
  495. L6=%10000001
  496. L7=%10000001
  497. L8=%11111111
  498. Set Curs L1,L2,L3,L4,L5,L6,L7,L8
  499. End Proc